home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -serious- / programming / basic / mildred / lha / mscreen2.lha / MScreen.ascii < prev    next >
Text File  |  1999-03-07  |  14KB  |  437 lines
  1. .Demo
  2. WBStartup
  3.  
  4. DEFTYPE.w
  5. MCPU Processor
  6. Mc2pCPUmode Processor
  7.  
  8. *ScrVP._ViewPort=0
  9. IsAGA.b=True ; Defaults to AGA
  10. Dim PlanarBuf.l(2) ; Base address of planar memory to output c2p to (allowed up to triple buffers)
  11.  
  12. PrefDisplayID.l=$0 ; Default ModeID (Pal:LowRes, or promotes to DoublePal:LowRes)
  13. PrefDisplayWidth.w=320 ; Default Width
  14. PrefDisplayHeight.w=240 ; Default Height
  15. PrefDisplayBuffering.b=3 ; 1..3. 1=Singlebuffered, 2=Doublebuffered, 3=Triplebuffered
  16. PrefDisplayMethod.b=1 ; 0=WritePixelArray8/WriteChunkyPixels, 1=MBlockScroll, 2=WritePixelArray(CGFX)
  17. PrefCGFXLock.b=True ; Wether when Method=1, CGFX LockBitmap will be attempted for safety and to get base address
  18. OSVersion.w=ExecVersion
  19. CGFXAvail.b=False ; Default
  20.  
  21. #DTAG_DISP=$80000000
  22. #DTAG_DIMS=$80001000
  23. #DTAG_MNTR=$80002000
  24. #DTAG_NAME=$80003000
  25. #LBMI_BASEADDRESS=$84001007
  26. #DIPF_IS_FOREIGN=$80000000
  27. #DIPF_IS_ECS=$00000010
  28. #DIPF_IS_AGA=$00010000
  29.  
  30. If Joyb(0)=0 AND Joyb(1)=0 Then Goto SkipSMR
  31.  
  32. NEWTYPE.SMode
  33.   DID.l
  34.   DWidth.l
  35.   DHeight.l
  36.   DDepth.w
  37.   DType.w
  38. End NEWTYPE
  39.  
  40. DEFTYPE.Hook myhook ; The hook for ASL tag as &myhook
  41. myhook\h_Entry=?hook
  42. MOVE.l a5,globalbase
  43. funcret.l=0
  44.  
  45. Dim SMRtags.TagItem(17)
  46. SMRtags(0)\ti_Tag=#ASLSM_InitialLeftEdge,160 ; X coord of requester
  47. SMRtags(1)\ti_Tag=#ASLSM_InitialTopEdge,0 ; Y coord of requester
  48. SMRtags(2)\ti_Tag=#ASLSM_InitialWidth,300 ; Width of requester
  49. SMRtags(3)\ti_Tag=#ASLSM_InitialHeight,400 ; Height of requester
  50. SMRtags(4)\ti_Tag=#ASLSM_InitialDisplayID,$21000 ; Default ModeID (Pal:LowRes)
  51. SMRtags(5)\ti_Tag=#ASLSM_InitialDisplayDepth,8 ; Default depth (8-bit usually)
  52. SMRtags(6)\ti_Tag=#ASLSM_InitialDisplayWidth,PrefDisplayWidth
  53. SMRtags(7)\ti_Tag=#ASLSM_InitialDisplayHeight,PrefDisplayHeight
  54. SMRtags(8)\ti_Tag=#ASLSM_InitialOverscanType,1 ; Default overscan type (Text)
  55. SMRtags(9)\ti_Tag=#ASLSM_InitialInfoOpened,1 ; Info window?
  56. SMRtags(10)\ti_Tag=#ASLSM_InitialInfoLeftEdge,350 ; X coord of info window
  57. SMRtags(11)\ti_Tag=#ASLSM_InitialInfoTopEdge,50 ; Y coord of info window
  58. SMRtags(12)\ti_Tag=#ASLSM_DoDepth,0 ; Depth gadget? (Generally NO for chunky 8-bit)
  59. SMRtags(13)\ti_Tag=#ASLSM_DoOverscanType,0 ; Overscan gadget?
  60. SMRtags(14)\ti_Tag=#ASLSM_DoWidth,0 ; Width gadget?
  61. SMRtags(15)\ti_Tag=#ASLSM_DoHeight,0 ; Height gadget?
  62. SMRtags(16)\ti_Tag=#ASLSM_FilterFunc,&myhook ; Address of callback hook routine
  63. SMRtags(17)\ti_Tag=#TAG_DONE,0
  64.  
  65. *sreq.SMode=0
  66. *sreq=AllocAslRequest_(2,&SMRtags(0)\ti_Tag)
  67. ok.b=AslRequest_(*sreq,&SMRtags(0)\ti_Tag)
  68.  
  69. If ok<>0
  70.   PrefDisplayID.l=*sreq\DID
  71.   PrefDisplayWidth.w=*sreq\DWidth
  72.   PrefDisplayHeight.w=*sreq\DHeight
  73. EndIf
  74. If (*sreq) Then FreeAslRequest_(*sreq)
  75.  
  76. Goto SkipSMR
  77.  
  78. ;*************************************************************************
  79. ; This is the statement that the hook will call.  Put the label before
  80. ; the statement you want to jump to.
  81. Runerrsoff
  82. hook_jump:
  83. Statement hook{*dahook.Hook, modeID.l, *smr.ScreenModeRequester}
  84.   ; We're inside the hook, and supposedly we should be able to do whatever
  85.   ; we want.
  86.   ; Filter modeID's here
  87.   SHARED funcret.l
  88.   DEFTYPE.DisplayInfo DisInfoBuf
  89.   DEFTYPE.DimensionInfo DimInfoBuf
  90.   DEFTYPE.MonitorInfo MonInfoBuf
  91.   DEFTYPE.NameInfo NamInfoBuf
  92.   ;Refer to Includes/Graphics/DisplayInfo.h or view newtypes
  93.   IDhandle.l=FindDisplayInfo_(modeID)
  94.   GetDisplayInfoData_ IDhandle,&DisInfoBuf,SizeOf.DisplayInfo,#DTAG_DISP,0
  95.   GetDisplayInfoData_ IDhandle,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
  96.   GetDisplayInfoData_ IDhandle,&MonInfoBuf,SizeOf.MonitorInfo,#DTAG_MNTR,0
  97.   GetDisplayInfoData_ IDhandle,&NamInfoBuf,SizeOf.NameInfo,#DTAG_NAME,0
  98.   ;Do tests. True=Mode is valid, False=mode is invalid.
  99.   ;See newtypes for DisplayInfo,DimensionInfo,MonitorInfo and NameInfo for things to further test
  100.   If DimInfoBuf\MaxDepth<>8
  101.     ;No true-colour modes, only 8-bit
  102.     funcret=False
  103.   Else
  104.     funcret=True
  105.   EndIf
  106. End Statement
  107.  
  108. ;**********************
  109. ; Hook
  110. Macro goto_hook
  111.   JSR `1+6
  112. End Macro
  113.  
  114. globalbase: Dc.l 0
  115.  
  116. hook: ;This hook is called by the filter hook callback from screenmode requester, per item
  117. ; Store registers
  118. MOVEM.l   d1-d7/a0-a6,-(a7) ; Not d0!
  119.  
  120. ; Put parameters into dregs ready for a statement
  121. MOVE.l    a0,d0
  122. MOVE.l    a1,d1
  123. MOVE.l    a2,d2
  124.  
  125. ; Get global variable base
  126. MOVE.l    globalbase,a5
  127.  
  128. ; Goto hook statement
  129. !goto_hook{hook_jump}
  130.  
  131. GetReg d0,funcret ; return accept/discard
  132.  
  133. ; Restore registers
  134. MOVEM.l   (a7)+,d1-d7/a0-a6 ; Not d0!
  135.  
  136. RTS
  137. ;**********************
  138.  
  139. Runerrson
  140. .SkipSMR
  141.  
  142. Function.b CheckLib{Lib$,LibVer}
  143. ;Returns wether a specific library is available or not
  144.   *lib.l=OpenLibrary_(&Lib$,LibVer)
  145.   If *lib
  146.     CloseLibrary_ *lib
  147.     Function Return True
  148.   Else
  149.     Function Return False
  150.   EndIf
  151. End Function
  152.  
  153. Function.b InitDisplay{Title$}
  154. ;Creates a display for AGA or Graphics-Card output
  155. ;Title$=The screen title (not displayed)
  156.   SHARED PrefDisplayWidth,PrefDisplayHeight,PrefDisplayBuffering
  157.   SHARED *ScrVP,PrefDisplayID,IsAGA,PlanarBuf(),CGFXAvail
  158.  
  159.   ;Setup a test screen
  160.   Dim ScrTags.TagItem(13)
  161.   Rect.Rectangle\MinX=0,0,320,240 ; For test
  162.   ScrTags(0)\ti_Tag=#SA_Width,320 ; For test
  163.   ScrTags(1)\ti_Tag=#SA_Height,240; For test
  164.   ScrTags(2)\ti_Tag=#SA_Depth,8
  165.   ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
  166.   ScrTags(4)\ti_Tag=#SA_Type,$F
  167.   ScrTags(5)\ti_Tag=#SA_Quiet,True
  168.   ScrTags(6)\ti_Tag=#SA_ShowTitle,False
  169.   ScrTags(7)\ti_Tag=#SA_Behind,True
  170.   ScrTags(8)\ti_Tag=#SA_DClip,&Rect ; For test
  171.   ScrTags(9)\ti_Tag=#SA_Exclusive,False
  172.   ScrTags(10)\ti_Tag=#SA_Draggable,False
  173.   ScrTags(11)\ti_Tag=#SA_AutoScroll,False
  174.   ScrTags(12)\ti_Tag=#TAG_DONE,0
  175.   ScrTags(13)\ti_Tag=#TAG_DONE,0
  176.  
  177.   If CGFXAvail
  178.     IsAGA=1-(IsCyberModeID_(PrefDisplayID))
  179.   Else
  180.     ; Need to do a test
  181.     UsedChip.l=320*240 ; With test params (depth 8)
  182.     FreeChip.l=AvailMem_(#MEMF_CHIP)
  183.     Forbid_
  184.     If ScreenTags(0,Title$,&ScrTags(0))
  185.       NowChip.l=AvailMem_(#MEMF_CHIP)
  186.       Permit_
  187.       If FreeChip-NowChip<UsedChip
  188.         IsAGA=False
  189.       Else
  190.         IsAGA=True
  191.       EndIf
  192.       VWait 5
  193.       Free Screen 0
  194.       VWait 5
  195.     Else
  196.       ; Failed to open, so resort to fixed AGA LowRes
  197.       Permit_
  198.       IsAGA=True
  199.       PrefDisplayID=0
  200.       PrefDisplayWidth=320
  201.       PrefDisplayHeight=240
  202.     EndIf
  203.   EndIf
  204.  
  205.   If IsAGA
  206.     PrefDisplayWidth AND $FFC0 ; Multiples of 64 for AGA
  207.   Else
  208.     PrefDisplayWidth AND $FFF0 ; Multiples of 16 for graphics card
  209.   EndIf
  210.   ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
  211.   Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
  212.   ScrTags(8)\ti_Tag=#SA_DClip,&Rect
  213.  
  214.   If IsAGA
  215.     ; AGA display
  216.     ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight ; Seperate buffers
  217.     ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
  218.     Forbid_
  219.     For Loop.w=0 To PrefDisplayBuffering-1
  220.       If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
  221.       If AvailMem_(#MEMF_CHIP)>=(PrefDisplayWidth*PrefDisplayHeight)+16
  222.         Memory.l=AllocMem((PrefDisplayWidth*PrefDisplayHeight)+16,$10002) ; Chipram bitmap
  223.         Memory=(Memory+16) AND $FFFFFFF0 ; Align for move16's
  224.         If Memory
  225.           CludgeBitMap Loop,PrefDisplayWidth,PrefDisplayHeight,8,Memory ; Depth 8
  226.           If Loop=0
  227.             ScrTags(12)\ti_Tag=#SA_BitMap,Addr BitMap(0)
  228.             If ScreenTags(0,Title$,&ScrTags(0))=0
  229.               Permit_
  230.               Function Return False
  231.             EndIf
  232.           EndIf
  233. If Window(Loop,0,0,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
  234.           Menus Off
  235.         Else
  236.           Permit_
  237.           Function Return False
  238.         EndIf
  239.       Else
  240.         Permit_
  241.         Function Return False
  242.       EndIf
  243.       PlanarBuf(Loop)=Memory
  244.     Next Loop
  245.     Permit_
  246.   Else
  247.     ; Graphics-card display
  248.     ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight*PrefDisplayBuffering
  249.     If ScreenTags(0,Title$,&ScrTags(0))
  250.       For Loop.w=0 To PrefDisplayBuffering-1
  251.         If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
  252. If Window(Loop,0,PrefDisplayHeight*Loop,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
  253.         Menus Off
  254.         ScreensBitMap 0,Loop
  255.         *TmpBmp.bitmap=Addr BitMap(Loop)
  256.         Offset.l=*TmpBmp\_ebwidth*(PrefDisplayHeight*Loop)
  257.         For DLoop.w=0 To 8-1 ; Depth of 8
  258.           *TmpBmp\_data[DLoop]=*TmpBmp\_data[DLoop]+Offset
  259.         Next DLoop
  260.       Next Loop
  261.     Else
  262.       Function Return False
  263.     EndIf
  264.   EndIf
  265.  
  266.   If Peek.l(Addr Screen(0))
  267.     DEFTYPE.DimensionInfo DimInfoBuf
  268.     GetDisplayInfoData_ FindDisplayInfo_(PrefDisplayID) AND $FFFFFFFF,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
  269.     PrefDisplayLeft.w=((DimInfoBuf\TxtOScan\MaxX)-PrefDisplayWidth)/2
  270.     PrefDisplayTop.w=((DimInfoBuf\TxtOScan\MaxY)-PrefDisplayHeight)/2
  271.     *Scr._Screen=Peek.l(Addr Screen(0))
  272.     *ScrVP=ViewPort(0)
  273.     *ScrVP\DxOffset=PrefDisplayLeft,PrefDisplayTop
  274.     ScrollVPort_ *ScrVP
  275.     RethinkDisplay_
  276.     Menus Off
  277.     If *ScrVP\DHeight<>PrefDisplayHeight
  278.       Forbid_
  279.       *Scr\Height=PrefDisplayHeight ; Enforce y clipping
  280.       Permit_
  281.     EndIf
  282.     ScreenToFront_ *Scr
  283.     Function Return True
  284.   Else
  285.     Function Return False
  286.   EndIf
  287. End Function
  288.  
  289. .Main
  290. CGFXAvail.b=CheckLib{"cybergraphics.library",0}
  291. If CGFXAvail=False AND PrefDisplayMethod=2 Then PrefDisplayMethod=0
  292. InitPalette 0,256
  293. For c=1 To 255 : AGAPalRGB 0,c,Rnd(255),Rnd(255),Rnd(255) : Next c
  294. If InitDisplay{"Game"}=False Then Goto Finish
  295. LoadRGB32_ *ScrVP,Peek.l(Addr Palette(0))
  296. If PrefDisplayMethod=0 AND OSVersion<40
  297.   MBitmap 5,PrefDisplayWidth,PrefDisplayHeight ; Temporary bitmap to allow WPA8 instead of WPL8's
  298. EndIf
  299.  
  300. MBitmap 0,PrefDisplayWidth,PrefDisplayHeight
  301. If IsAGA Then Mc2pWindow 0,PrefDisplayWidth,PrefDisplayHeight
  302.  
  303. .Table
  304. ;Set up movement table
  305. #Objects=500
  306. Dim x.w(#Objects)
  307. Dim y.w(#Objects)
  308. Dim xdirection.b(#Objects)
  309. Dim ydirection.b(#Objects)
  310. Dim xdirectionswap.b(#Objects)
  311. Dim ydirectionswap.b(#Objects)
  312. For obj=1 To #Objects
  313.   x(obj)=Rnd(PrefDisplayWidth-32)+16
  314.   y(obj)=Rnd(PrefDisplayHeight-32)+16
  315.   Repeat
  316.     xdirection(obj)=Rnd(8)-4
  317.   Until xdirection(obj)<>0
  318.   Repeat
  319.     ydirection(obj)=Rnd(8)-4
  320.   Until ydirection(obj)<>0
  321.   xdirectionswap(obj)=-xdirection(obj)
  322.   ydirectionswap(obj)=-ydirection(obj)
  323. Next obj
  324.  
  325. .Loop
  326. buf.b=0
  327. its.l=0
  328. cnt.b=0
  329. ResetTimer
  330. While Joyb(0)=0 AND Joyb(1)=0
  331.  
  332.   For obj=1 To #Objects
  333.     x(obj)+xdirection(obj)
  334.     If x(obj)<8 OR x(obj)>PrefDisplayWidth-8 Then Exchange xdirection(obj),xdirectionswap(obj)
  335.     y(obj)+ydirection(obj)
  336.     If y(obj)<8 OR y(obj)>PrefDisplayHeight-8 Then Exchange ydirection(obj),ydirectionswap(obj)
  337.   Next obj
  338.   For obj=1 To #Objects-1
  339.     MLine x(obj),y(obj),x(obj+1),y(obj+1),obj
  340.   Next obj
  341.   MLine x(#Objects),y(#Objects),x(1),y(1),1
  342.  
  343.   ;Display
  344.   If IsAGA
  345.     Mc2p MBitmapPtr(0),PlanarBuf(buf)
  346.     If PrefDisplayBuffering>1
  347.       ShowBitMap buf
  348.       buf+1
  349.       If buf=PrefDisplayBuffering Then buf=0
  350.     EndIf
  351.   Else
  352.     *RP0._RastPort=RastPort(0)
  353.     Select PrefDisplayMethod
  354.  
  355.       Case 0 ; WritePixelArray8
  356.       If PrefDisplayBuffering>1
  357.         *RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
  358.         If OSVersion<40
  359.           MUseBitmap 5
  360.           MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From window in modulo bitmap, to nonmodulo bitmap
  361.           MUseBitmap 0
  362.           WritePixelArray8_ *RP1,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(5),0
  363.         Else
  364.           WriteChunkyPixels_ *RP1,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(0),MBitmapWidth(0)
  365.         EndIf
  366.         ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
  367.         If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
  368.       Else
  369.         If OSVersion<40
  370.           MUseBitmap5
  371.           MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From window in modulo bitmap, to nonmodulo bitmap
  372.           MUseBitmap 0
  373.           WritePixelArray8_ *RP0,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(5),0
  374.         Else
  375.           WriteChunkyPixels_ *RP0,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(0),MBitmapWidth(0)
  376.         EndIf
  377.       EndIf
  378.  
  379.       Case 1 ; MBlockScroll
  380.       If CGFXAvail AND PrefCGFXLock
  381.         Dim CGFXTags.TagItem(1)
  382.         CGFXData.l=0
  383.         CGFXTags(0)\ti_Tag=#LBMI_BASEADDRESS,&CGFXData
  384.         CGFXTags(1)\ti_Tag=#TAG_DONE,0
  385.         LockHandle.l=LockBitMapTagList_(*RP0\_BitMap,&CGFXTags(0))
  386.         MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,CGFXData
  387.       Else
  388.         MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,*RP0\_BitMap\Planes
  389.       EndIf
  390.       If PrefDisplayBuffering>1
  391.         *RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
  392.         MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,PrefDisplayHeight+(cnt*PrefDisplayHeight),0 ; From modulo bitmap
  393.         ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
  394.         If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
  395.       Else
  396.         MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From modulo bitmap
  397.       EndIf
  398.       MUseBitmap 0
  399.       If CGFXAvail AND (LockHandle<>0) AND PrefCGFXLock Then UnLockBitMap_ LockHandle
  400.  
  401.       Case 2 ; CGFXWriteChunkyPixels
  402.       If PrefDisplayBuffering>1
  403.         *RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
  404.         WritePixelArray_ MBitmapPtr(0),0,0,MBitmapWidth(0),*RP1,0,0,PrefDisplayWidth,PrefDisplayHeight,#RECTFMT_LUT8
  405.         ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
  406.         If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
  407.       Else
  408.         WritePixelArray_ MBitmapPtr(0),0,0,MBitmapWidth(0),*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,#RECTFMT_LUT8
  409.       EndIf
  410.     End Select
  411.   EndIf
  412.  
  413.   MCls
  414.  
  415.   its+1
  416. Wend
  417.  
  418. ;Report
  419. t=Timer
  420. t=Max(t,1)
  421. its=Max(its,1)
  422. a.q=50.0/(t/its)
  423. WBenchToFront_
  424. WbToScreen 1
  425. Window 2,16,16,300,40,0,"Test results",1,0
  426. WindowOutput 2
  427. NPrint a," frames per second"
  428. NPrint " "
  429. NPrint "Press mouse/joy button..."
  430. VWait 20
  431. Repeat
  432. Until Joyb(0)<>0 OR Joyb(1)<>0
  433.  
  434. Finish:
  435. End
  436.  
  437.